(defpackage :oop
  (:use :cl))

(in-package :oop)

(defparameter *object-name-table* (make-hash-table)
  "Hash table mapping class names to classes")

;; FIXME: replace alist stuff with hash tables
(defmacro defobject (name (&optional parent) &body methods)
  (declare (ignore parent))
  `(progn
     (setf (gethash ',name *object-name-table*)
	   (list ,@(loop for method in methods
			 collect (destructuring-bind (method-name
						      method-args
						      &body method-body)
				     method
				   `(cons ',method-name
					  #'(lambda ,method-args
					      ,@method-body))))))))

(defun make-object (classname)
  (let ((slots (make-hash-table)))
    #'(lambda (method-name)
	#'(lambda (&rest args)
	    (apply (cdr (assoc method-name
			       (gethash classname *object-name-table*)))
		   slots
		   args)))))

(defun slot (object slot)
  (gethash slot object))

(defun (setf slot) (value object slot)
  (setf (gethash slot object)
	value))

(defobject shape ()
  (name (self)
	(slot self 'name))
  (set-name (self name)
	    (setf (slot self 'name)
		  name))
  (area (self)
	(error "How should I know?")))

(defobject rectangle (shape)
  (area (self)
	(* (slot self 'width)
	   (slot self 'height))))